home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / energize / energize-windows.el < prev    next >
Encoding:
Text File  |  1994-12-09  |  15.6 KB  |  405 lines
  1. ;;; -*- Mode:Emacs-Lisp -*-
  2. ;;; Copyright ⌐ 1992 by Lucid, Inc.  All Rights Reserved.
  3.  
  4. ;;; Displaying buffers.  Why is this so hard?
  5.  
  6.  
  7. ;;; This crud is damage control, because sometimes things get confused, and
  8. ;;; the server asks us to display a buffer that has been killed.  
  9.  
  10. (defun energize-request-kill-buffer-if-dead (buffer)
  11.   (cond ((not (bufferp buffer)) t)
  12.         ((null (buffer-name buffer))
  13.          (if (energize-buffer-p buffer)
  14.              (energize-request-kill-buffer buffer))
  15.          t)
  16.         (t nil)))
  17.  
  18. (defun energize-prune-killed-buffers-from-list (buffer-extent-list)
  19.   (let ((rest buffer-extent-list)
  20.         (buffer-count 0)
  21.         (deleted-count 0))
  22.     (while rest
  23.       (let* ((buffer (car rest))
  24.              (extent (car (cdr rest))))
  25.         (setq rest (cdr (cdr rest)))
  26.         (setq buffer-count (1+ buffer-count))
  27.         (if (energize-request-kill-buffer-if-dead buffer)
  28.             (progn
  29.               (setq deleted-count (1+ deleted-count))
  30.               (setq buffer-extent-list (delq buffer buffer-extent-list))
  31.               (setq buffer-extent-list (delq extent buffer-extent-list))))))
  32.     (if (> deleted-count 0)
  33.         (progn
  34.           (message 
  35.             (format "Oops, confused about %s selected %s -- please try again."
  36.                     (if (> deleted-count 1) 
  37.                         (format "%d of the" deleted-count)
  38.                         (if (> buffer-count 1)
  39.                             "one of the"
  40.                             "the"))
  41.                     (if (> buffer-count 1)
  42.                         "buffers"
  43.                         "buffer")))
  44.           (ding t)))
  45.     buffer-extent-list))
  46.  
  47.  
  48. (defvar energize-auto-scroll-p t    ;#### this should be nil, t is LOSING
  49.   "*If t, energize will scroll your debugger and error log buffers
  50. to the bottom whenever output appears with reckless abandon.  If nil,
  51. it will behave just like normal shell and gdb-mode buffers.")
  52.  
  53. (defvar energize-error-log-context-lines 0
  54.   "*Number of lines to skip above the current error in the Energize error log")
  55.  
  56. ;;; called by energize-show-all-buffers
  57. ;;; If the extent is specified:
  58. ;;;   - scrolls the window so that point is at at the beginning of the extent.
  59. ;;;   - If the buffer is "Error Log", the extent is moved to top-of-window.
  60. ;;;   - if `only-one' and the buffer is a source buffer, then... what?
  61. ;;; If the buffer is "*Debugger*" or "Error Log", point is moved to eof,
  62. ;;;   IF and ONLY if it was at EOF already.
  63. ;;;
  64. (defun energize-scroll-window-at-extent (window extent only-one)
  65.   (let* ((buffer (window-buffer window))
  66.      (type (energize-buffer-type buffer)))
  67.     (if (and extent (null (extent-start-position extent)))
  68.     ;; it has been detached somehow.
  69.     (setq extent nil))
  70.     (if extent
  71.     (let ((pos (extent-start-position extent)))
  72.       (if (not (eq pos 0))
  73.           (progn
  74.         (set-window-point window pos)
  75.         (cond ((eq type 'energize-error-log-buffer)
  76.                ;; scroll the Error Log buffer so that the first error
  77.                ;; is at the top of the window.
  78.                (set-window-start window
  79.                      (save-excursion
  80.                        (set-buffer buffer)
  81.                        (goto-char pos)
  82.                        (forward-line
  83.                         (-
  84.                          energize-error-log-context-lines))
  85.                        (beginning-of-line)
  86.                        (point))))
  87.               ((and only-one (eq type 'energize-source-buffer))
  88.                ;; if only one buffer is requested to be visible and it
  89.                ;; is a source buffer then scroll point close to the top
  90.                (set-window-start window
  91.                      (save-excursion
  92.                        (set-buffer buffer)
  93.                        (goto-char pos)
  94.                        (beginning-of-line)
  95.                        (if (> (window-height window)
  96.                           next-screen-context-lines)
  97.                            (vertical-motion
  98.                         (- next-screen-context-lines)
  99.                         window)
  100.                          (vertical-motion -1 window))
  101.                        (point)))))))))
  102.  
  103.     (cond ((and (memq type '(energize-error-log-buffer
  104.                  energize-debugger-buffer))
  105.         ; don't move point if it's before the last line
  106.         (or energize-auto-scroll-p
  107.             (>= (window-point window)
  108.             (save-excursion
  109.               (set-buffer (window-buffer window))
  110.               ;;(comint-mark)
  111.               (energize-user-input-buffer-mark)
  112.               )))
  113.         )
  114.        ;; Debugger and Error Log buffers generally get scrolled to
  115.        ;; the bottom when displayed.
  116.        (set-window-point window
  117.                  (save-excursion (set-buffer buffer)
  118.                          (+ 1 (buffer-size))))
  119.        ;; Careful to deactivate the selection when automatically moving
  120.        ;; the user to the end of the buffer.  This is suboptimal, but
  121.        ;; otherwise we have bad interactions with the debugger-panel
  122.        ;; Print button.  (Double-click on a value (point is now at the
  123.        ;; end of that word); hit Print; point is now at point-max, but
  124.        ;; the original word is still highlighted, which is incorrect -
  125.        ;; we're now in a state where the selection highlighting and the
  126.        ;; region between point and mark is out of sync.  I'm not entirely
  127.        ;; sure how to fix this short of using a point-motion hook of some
  128.        ;; kind, so we'll punt, and just deactivate the region instead.)
  129.        (zmacs-deactivate-region)
  130.        ))))
  131.  
  132.  
  133. ;;; called by energize-make-buffers-visible
  134. ;;; For each of the contents of an plist of buffers and extents:
  135. ;;;   - If the buffer is visible in a window
  136. ;;;     - dedicate the window
  137. ;;;     - energize-scroll-window-at-extent
  138. ;;; If we dedicated any windows, select the last one dedicated.
  139. ;;; For each of the buffers and extents:
  140. ;;;   - pop-to-buffer
  141. ;;;   - remember the first window selected in this way
  142. ;;;   - dedicate the window
  143. ;;;   - energize-scroll-window-at-extent; only-one arg is true if there
  144. ;;;     is only one buffer/extent pair in the list
  145. ;;;   - if energize-edit-buffer-externally-p make it read-only
  146. ;;; Un-dedicate the windows
  147. ;;; Select the remembered window (the first one we popped-to-buffer on)
  148. ;;; Maybe raise its frame
  149. ;;;
  150. (defun energize-show-all-buffers (buffer-extent-list)
  151.   (let ((pop-up-windows t)
  152.     (dedicated-windows ())
  153.     (buffer-extent-current)
  154.     (window-to-select ())
  155.     (only-one (null (cdr (cdr buffer-extent-list)))))
  156.     (setq buffer-extent-current buffer-extent-list)
  157.     (while buffer-extent-current
  158.       (let* ((buffer (car buffer-extent-current))
  159.          (extent (car (cdr buffer-extent-current)))
  160.          (window (get-buffer-window buffer (selected-frame))))
  161.     (if window
  162.         (progn
  163.           (set-window-buffer-dedicated window buffer)
  164.           (setq dedicated-windows (cons window dedicated-windows))
  165.           (energize-scroll-window-at-extent window extent only-one)))
  166.     (setq buffer-extent-current (cdr (cdr buffer-extent-current)))))
  167.     (if dedicated-windows
  168.     (select-window (car dedicated-windows)))
  169.     (setq buffer-extent-current buffer-extent-list)
  170.     (while buffer-extent-current
  171.       (let* ((buffer (car buffer-extent-current))
  172.          (extent (car (cdr buffer-extent-current))))
  173. ;; ## what was this intended to do? a frame is being passed as the
  174. ;; ## argument which means "always select a different window even if
  175. ;; ## it's visible in the selected window.
  176. ;;    (pop-to-buffer buffer nil (selected-frame))
  177.     (pop-to-buffer buffer)
  178.     (if (energize-edit-buffer-externally-p buffer)
  179.         (setq buffer-read-only t))
  180.     (let ((window (selected-window)))
  181.       (if (null window-to-select)
  182.           (setq window-to-select window))
  183.       (set-window-buffer-dedicated window buffer)
  184.       (setq dedicated-windows (cons window dedicated-windows))
  185.       (energize-scroll-window-at-extent window extent only-one))
  186.     (setq buffer-extent-current (cdr (cdr buffer-extent-current)))))
  187.     (while dedicated-windows
  188.       (set-window-buffer-dedicated (car dedicated-windows) ())
  189.       (setq dedicated-windows (cdr dedicated-windows)))
  190.  
  191.     (select-window window-to-select)
  192.     ;; now we may have to pop the frame up
  193.     (let ((frame (selected-frame)))
  194.       (if (and energize-auto-raise-screen
  195.            (or (not (frame-visible-p frame))
  196.            (not (frame-totally-visible-p frame))))
  197.       (progn
  198.         (sit-for 0)
  199.         (make-frame-visible frame))))))
  200.  
  201. ;;; called by energize-make-buffers-visible
  202. (defun energize-main-buffer-of-list (list)
  203.   ;; Given an alternating list of buffers and extents, pick out the
  204.   ;; "interesting" buffer.  If one of the buffers is in debugger-mode,
  205.   ;; or in breakpoint-mode, then that's the interesting one; otherwise,
  206.   ;; the last buffer in the list is the interesting one.
  207.   (let (buffer mode result)
  208.     (while list
  209.       (setq buffer (car list))
  210.       (or (memq mode '(energize-debugger-mode energize-breakpoint-mode))
  211.       (setq result buffer
  212.         mode (save-excursion (set-buffer buffer) major-mode)))
  213.       (setq list (cdr (cdr list))))
  214.     result))
  215.  
  216. ;;; called by energize-make-many-buffers-visible-function
  217. ;;; If there is only one buffer/extent pair, and it's a source buffer, then
  218. ;;;  edit it in vi if that's the kind of kinkiness we're into.
  219. ;;; Get the "main" buffer, and select a frame for it.
  220. ;;; Then call energize-show-all-buffers.
  221. ;;;
  222. (defun energize-make-buffers-visible (buffer-extent-list)
  223.   (let ((main-buffer (energize-main-buffer-of-list buffer-extent-list))
  224.     window)
  225.     (if (and (null (cdr (cdr buffer-extent-list)))
  226.          (energize-edit-buffer-externally-p main-buffer))
  227.     (energize-edit-buffer-externally-1 main-buffer
  228.                        (car (cdr buffer-extent-list)))
  229.       ;; This may create and/or select a frame as a side-effect.
  230.       ;; I'm not sure it's necessary to call this, as display-buffer
  231.       ;; calls it too.  But it can't hurt to select the appropriate
  232.       ;; frame early...
  233.       (let ((hacked-frame nil))
  234.     (cond ((null energize-split-screens-p)
  235.            nil)
  236.           ((get-frame-name-for-buffer main-buffer)
  237.            (setq hacked-frame t)
  238.            (if pre-display-buffer-function
  239.            (funcall pre-display-buffer-function main-buffer nil nil))
  240.            )
  241.           ((setq window (get-buffer-window main-buffer t))
  242.            (cond (window
  243.               (setq hacked-frame t)
  244.               (select-frame (window-frame window))))))
  245.     (let ((pre-display-buffer-function
  246.            (if hacked-frame nil pre-display-buffer-function)))
  247.       (energize-show-all-buffers buffer-extent-list))
  248. ;;    ;; kludge!!  Select the debugger frame, not the sources frame.
  249. ;;    (if (and (null energize-split-screens-p)
  250. ;;         pre-display-buffer-function)
  251. ;;        (funcall pre-display-buffer-function main-buffer nil nil))
  252.     ))))
  253.  
  254. ;;; this is the guts of energize-make-many-buffers-visible
  255. ;;; `arg' is really two args: `buffer-extent-list' and `go-there'.
  256. ;;; go-there is specified by 
  257. ;;; Given a list of buffer/extent pairs, make them all visible at once
  258. ;;;  (presumably in the same frame?)
  259. ;;; If `go-there'
  260. ;;;  - call energize-make-buffers-visible
  261. ;;; else
  262. ;;;  - dedicate the selected window
  263. ;;;  - call energize-make-buffers-visible
  264. ;;;  - re-select and undedicate the original selected window
  265. ;;;
  266. (defun energize-make-many-buffers-visible-function (arg)
  267.   (let ((buffer-extent-list (car arg))
  268.     (go-there (cdr arg)))
  269.     ;; enqueue an history record if we're going to move
  270.     (if go-there
  271.     (energize-history-enqueue))
  272.     (setq buffer-extent-list 
  273.       (energize-prune-killed-buffers-from-list buffer-extent-list))
  274.     (if buffer-extent-list
  275.     (if go-there
  276.         (energize-make-buffers-visible buffer-extent-list)
  277.       (let ((window (selected-window)))
  278.         (set-window-buffer-dedicated window (window-buffer window))
  279.         (unwind-protect 
  280.         (energize-make-buffers-visible buffer-extent-list)
  281.           (set-window-buffer-dedicated window ())
  282.           (select-window window)))))))
  283.  
  284. (defvar energize-make-many-buffers-visible-should-enqueue-event t
  285.   "Special variable bound by energize-execute-command to allow the
  286. buffers to be selected while the command is executed")
  287.  
  288. ;;; called by by editorside.c:MakeBufferAndExtentVisible().
  289. ;;; should-enqueue is bound by `energize-execute-command'
  290. ;;;
  291. (defun energize-make-many-buffers-visible (buffer-extent-list go-there)
  292.   "First arg is a list of buffers and extents. All those should be
  293. made visible at the same time.  If the second argument is T then point
  294. should be moved to the first character of the extent of the first
  295. buffer, or to the buffer if no extent is specified for this buffer.  
  296. If second argument is NIL point should not change."
  297.   (if energize-make-many-buffers-visible-should-enqueue-event
  298.       ;; don't do it from process filters, but wait until we come back to
  299.       ;; top-level.  Using go-there should still be done sparingly, as we can
  300.       ;; surprise the user and grab their keystrokes into another buffer.
  301.       (enqueue-eval-event 'energize-make-many-buffers-visible-function
  302.               (cons buffer-extent-list go-there))
  303.     ;; go-there is always true when called from energize-execute-command,
  304.     ;; I guess under the assumption that it's always ok to select a buffer
  305.     ;; when we're doing something in direct response to a menu selection.
  306.     (energize-make-many-buffers-visible-function
  307.      (cons buffer-extent-list t))))
  308.  
  309.  
  310. ;;; This deales with the energize history
  311. (defvar energize-navigation-history '(nil)
  312.   "List of places where Energize took you to.
  313. It is a list of (file-name/buffer-name . position)")
  314.  
  315. (defvar energize-history-maximum-length 20
  316.   "Maximum number of locations kept in the energize history")
  317.  
  318. (defvar energize-navigation-current ()
  319.   "Current pointer into the energize-navigation-history")
  320.  
  321. (defvar energize-navigation-current-length 0)
  322.  
  323. (defun energize-history-enqueue ()
  324.   "Memorize the current place in the history.
  325. Trim the history if need be."
  326.   (let ((new-item
  327.      (cons (or buffer-file-truename (current-buffer))
  328.            (1+ (count-lines 1 (point))))))
  329.     (if (not (equal new-item (car energize-navigation-history)))
  330.     (progn
  331.       (setq energize-navigation-history
  332.         (cons new-item energize-navigation-history))
  333.       (setq energize-navigation-current-length
  334.         (1+ energize-navigation-current-length))
  335.       (if (> energize-navigation-current-length
  336.          (* 2 energize-history-maximum-length))
  337.           (let ((tail (nthcdr energize-history-maximum-length
  338.                   energize-navigation-history)))
  339.         (rplacd tail nil)
  340.         (setq energize-navigation-current-length
  341.               energize-history-maximum-length)))))))
  342.  
  343. (defun energize-history-dequeue ()
  344.   "Forget the current place in the history"
  345.   (setq energize-navigation-history (cdr energize-navigation-history)))
  346.  
  347. (defun energize-history-go-back (item)
  348.   "Go back to the place memorized by item"
  349.   (let ((buffer-or-file (car item))
  350.     (position (cdr item))
  351.     (buffer ()))
  352.     (cond ((bufferp buffer-or-file)
  353.        (setq buffer buffer-or-file))
  354.       ((stringp buffer-or-file)
  355.        (setq buffer (or (get-file-buffer buffer-or-file)
  356.                 (find-file-noselect buffer-or-file)))))
  357.     (if (null (buffer-name buffer))
  358.     ()
  359.       (pop-to-buffer buffer)
  360.       (goto-line position)
  361.       t)))
  362.  
  363. (defun energize-history-previous ()
  364.   "Go back in the history.
  365. If the last command was the same go back more"
  366.   (interactive)
  367.   (if (not (eq last-command 'energize-history-previous))
  368.       (setq energize-navigation-current energize-navigation-history))
  369.   (energize-history-enqueue)
  370.   (while (and (car energize-navigation-current)
  371.           (not
  372.            (energize-history-go-back (car energize-navigation-current))))
  373.     (rplaca energize-navigation-current
  374.         (car (cdr energize-navigation-current)))
  375.     (rplacd energize-navigation-current
  376.         (cdr (cdr energize-navigation-current))))
  377.   (if (null (car energize-navigation-current))
  378.       (progn
  379.     (energize-history-dequeue)
  380.     (setq last-command 'beep)
  381.     (error "You reached the beginning of the Energize history"))
  382.     (setq energize-navigation-current
  383.       (cdr energize-navigation-current))))
  384.  
  385. (define-key global-map '(shift f14) 'energize-history-previous)
  386.  
  387. (defun energize-history ()
  388.   "Show the energize history in the energize history buffer"
  389.   (interactive)
  390.   (pop-to-buffer "*Energize History*")
  391.   (erase-buffer)
  392.   (mapcar (function (lambda (item)
  393.               (if item
  394.               (progn
  395.                 (insert (format "%s" (car item)))
  396.                 (indent-to-column 32 1)
  397.                 (insert (format "%s\n" (cdr item)))))))
  398.       energize-navigation-history)
  399.   (goto-char (point-min))
  400.   (energize-history-mode))
  401.  
  402. (defun energize-history-mode ()
  403.   "Turn on energize history mode"
  404.   )
  405.